home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / djmeter / djmeter.ctl next >
Text File  |  1998-12-16  |  6KB  |  204 lines
  1. VERSION 5.00
  2. Begin VB.UserControl DJMeter 
  3.    ClientHeight    =   570
  4.    ClientLeft      =   0
  5.    ClientTop       =   0
  6.    ClientWidth     =   1740
  7.    ScaleHeight     =   570
  8.    ScaleWidth      =   1740
  9.    Begin VB.PictureBox picMeter 
  10.       Align           =   2  'Align Bottom
  11.       ClipControls    =   0   'False
  12.       Height          =   240
  13.       Left            =   0
  14.       ScaleHeight     =   180
  15.       ScaleWidth      =   1680
  16.       TabIndex        =   1
  17.       Top             =   330
  18.       Width           =   1740
  19.       Begin VB.Shape shpMeter 
  20.          BorderStyle     =   0  'Transparent
  21.          FillColor       =   &H000000FF&
  22.          FillStyle       =   0  'Solid
  23.          Height          =   135
  24.          Left            =   0
  25.          Top             =   0
  26.          Width           =   375
  27.       End
  28.    End
  29.    Begin VB.Label lblMessage 
  30.       Alignment       =   2  'Center
  31.       AutoSize        =   -1  'True
  32.       Height          =   195
  33.       Left            =   225
  34.       TabIndex        =   0
  35.       Top             =   60
  36.       Width           =   75
  37.    End
  38. End
  39. Attribute VB_Name = "DJMeter"
  40. Attribute VB_GlobalNameSpace = False
  41. Attribute VB_Creatable = True
  42. Attribute VB_PredeclaredId = False
  43. Attribute VB_Exposed = True
  44. Attribute VB_Ext_KEY = "PropPageWizardRun" ,"Yes"
  45. Option Explicit
  46. Const conMessageHeight = 0.5
  47. Dim mlngPercent As Long
  48. Const conDefaultPercent = 100
  49. 'Default Property Values:
  50. Const m_def_BackColor = 0
  51. 'Property Variables:
  52. Dim m_BackColor As OLE_COLOR
  53.  
  54. Public Event Click()
  55. Attribute Click.VB_Description = "click meter event"
  56. Public Event Change()
  57. Attribute Change.VB_Description = "change meter event"
  58.  
  59.  
  60.  
  61. Public Property Get Caption() As String
  62. Attribute Caption.VB_Description = "Sets/returns meter caption"
  63.     Caption = lblMessage.Caption
  64. End Property
  65.  
  66. Public Property Let Caption(ByVal NewCaption As String)
  67.     lblMessage.Caption = NewCaption
  68.     PropertyChanged "Caption"
  69. End Property
  70.  
  71. Private Sub SetPercent()
  72.     shpMeter.Width = picMeter.Width * Me.Percent / 100
  73.     RaiseEvent Change
  74. End Sub
  75.  
  76. Property Get Percent() As Long
  77. Attribute Percent.VB_Description = "Sets/returns pecentage of meter filled."
  78.     Percent = mlngPercent
  79. End Property
  80.  
  81. Property Let Percent(ByVal NewPercent As Long)
  82.     If NewPercent <= 100 Then
  83.         mlngPercent = NewPercent
  84.         Call SetPercent
  85.         
  86.         PropertyChanged "Percent"
  87.     Else
  88.         Err.Raise vbObjectError + 1111, _
  89.          "Meter::Percent (Let)", _
  90.          "Percent must be between 0 and 100."
  91.     End If
  92. End Property
  93.  
  94. Public Property Get Font() As Font
  95. Attribute Font.VB_Description = "Sets/returns font of caption"
  96. Attribute Font.VB_UserMemId = -512
  97.     Set Font = lblMessage.Font
  98. End Property
  99.  
  100. Public Property Set Font(ByVal NewFont As Font)
  101.     Set lblMessage.Font = NewFont
  102.     PropertyChanged "Font"
  103. End Property
  104. '
  105. 'Public Property Get BackColor() As OLE_COLOR
  106. '    BackColor = lblMessage.BackColor
  107. 'End Property
  108. '
  109. 'Public Property Let BackColor(ByVal NewBackColor As OLE_COLOR)
  110. '    lblMessage.BackColor = NewBackColor
  111. '    PropertyChanged "BackColor"
  112. 'End Property
  113.  
  114. Private Sub UserControl_Resize()
  115.     ' Set the width of the label control.
  116.     ' Set the height to the chosen ratio of the
  117.     ' control's height.
  118.     lblMessage.Move 0, 0, _
  119.      UserControl.ScaleWidth, _
  120.      UserControl.ScaleHeight * conMessageHeight
  121.     picMeter.Move 0, lblMessage.Height, _
  122.      lblMessage.Width, _
  123.      UserControl.ScaleHeight * (1 - conMessageHeight)
  124.     shpMeter.Move 0, 0, shpMeter.Width, picMeter.Height
  125. End Sub
  126.  
  127. Private Sub UserControl_InitProperties()
  128.     Me.Percent = conDefaultPercent
  129.     Me.Caption = Extender.Name
  130.     Me.BackColor = Ambient.BackColor
  131.     Set Me.Font = Ambient.Font
  132.     Debug.Print "InitProperties"
  133.     m_BackColor = m_def_BackColor
  134. End Sub
  135. Private Sub UserControl_WriteProperties( _
  136.  PropBag As PropertyBag)
  137.     Call PropBag.WriteProperty("Caption", _
  138.      lblMessage.Caption, "")
  139.     Call PropBag.WriteProperty("Percent", _
  140.      mlngPercent, conDefaultPercent)
  141.     Call PropBag.WriteProperty("BackColor", _
  142.      lblMessage.BackColor, vbButtonText)
  143.     Call PropBag.WriteProperty("Font", _
  144.      Font, Ambient.Font)
  145.     Debug.Print "WriteProperties"
  146.     Call PropBag.WriteProperty("BackColor", m_BackColor, m_def_BackColor)
  147.     Call PropBag.WriteProperty("FillColor", shpMeter.FillColor, &HFF&)
  148. End Sub
  149. Private Sub UserControl_ReadProperties( _
  150.  PropBag As PropertyBag)
  151.     lblMessage.Caption = PropBag.ReadProperty( _
  152.      "Caption", lblMessage.Caption)
  153.     Set Font = PropBag.ReadProperty( _
  154.      "Font", Ambient.Font)
  155.     shpMeter.FillColor = PropBag.ReadProperty( _
  156.     "FillColor", shpMeter.FillColor)
  157.     lblMessage.BackColor = PropBag.ReadProperty( _
  158.      "BackColor", lblMessage.BackColor)
  159.     mlngPercent = PropBag.ReadProperty( _
  160.      "Percent", conDefaultPercent)
  161.     ' Don't forget to set the width of the meter.
  162.     Call SetPercent
  163.     m_BackColor = PropBag.ReadProperty("BackColor", m_def_BackColor)
  164.     shpMeter.FillColor = PropBag.ReadProperty("FillColor", &HFF&)
  165. End Sub
  166.  
  167. Public Property Get BackColor() As OLE_COLOR
  168. Attribute BackColor.VB_Description = "Sets/Returns backcolor of meter."
  169.     BackColor = m_BackColor
  170. End Property
  171.  
  172. Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
  173.     m_BackColor = New_BackColor
  174.     PropertyChanged "BackColor"
  175. End Property
  176.  
  177. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  178. 'MappingInfo=shpMeter,shpMeter,-1,FillColor
  179. Public Property Get FillColor() As OLE_COLOR
  180. Attribute FillColor.VB_Description = "Returns/sets the color used to fill in shapes, circles, and boxes."
  181.     FillColor = shpMeter.FillColor
  182. End Property
  183.  
  184. Public Property Let FillColor(ByVal New_FillColor As OLE_COLOR)
  185.     shpMeter.FillColor() = New_FillColor
  186.     PropertyChanged "FillColor"
  187. End Property
  188.  
  189. Private Sub lblMessage_Click()
  190.     RaiseEvent Click
  191. End Sub
  192.  
  193. Private Sub picMeter_Click()
  194.     RaiseEvent Click
  195. End Sub
  196.  
  197. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  198. 'MappingInfo=lblMessage,lblMessage,-1,Refresh
  199. Public Sub Refresh()
  200. Attribute Refresh.VB_Description = "Forces a complete repaint of a object."
  201.   lblMessage.Refresh
  202. End Sub
  203.  
  204.